unit CPStringHashMap;

interface

uses SysUtils, Contnrs, CPParserBase;

type
  PCPHashItem = ^TCPHashItem;
  PPCPHashItem = ^PCPHashItem;

  TCPHashItem = record
    Next: PCPHashItem;
    Key: string;
    Value: TObject;
  end;

  TPCPHashItemArray = array of PCPHashItem;

  { Stores a list of key-value pairs as hash map. Keys are strings and values
    are TObject instances. Key matching can be either case-sensitive or not. }
  TCPStringHashMap = class
  private
    { If true, then key matching is case sensitive. }
    FCaseSensitive: Boolean;
    { Number of elements }
    FCount: Integer;
    { Array of hash items }
    FBuckets: TPCPHashItemArray;
    function GetValues(Key: string): TObject;
    procedure SetValues(Key: string; const Value: TObject);
  protected
    { Converts the specified key to canonical key. If key matching is
      case-sensitive then the original key is returned; otherwise, the key is
      returned in lower case.
      @param Key Key string that is to be converted into a canonical key
      @return Canonical key }
    function GetCanonicalKey(Key: string): string;
    { Finds the internal hash item mapped to this key string. If the key
      does not exist, then nil is returned. }
    function Find(const Key: string): PPCPHashItem;
    { Returns the hash code for the specified canonical key
      @param CanonicalKey Canonical key
      @return Hash code for canonical key }
    function HashOf(const CanonicalKey: string): Cardinal; virtual;
    { Changes the value for the specified key. If no such key exists, then
      False is returned; otherwise, true.
      @param Key Key string
      @param New value for the specified key
      @return True, if the specified key exists and a new value was assigned;
        otherwise, false. }
    function Modify(const Key: string; Value: TObject): Boolean;
    { Adds a new key-value pair.
      @param Key Key string
      @param Value Value for the spciefied key }
    procedure Add(const Key: string; Value: TObject);
  public
    { Creates a new string hash map.
      @param CaseSensitive If true, then case sensitive key matching is used;
        otherwise, the key matching will be case insensitive.
      @param Size Size of the inernal hash table }
    constructor Create(CaseSensitive: Boolean = true; Size: Cardinal = 256);
    destructor Destroy; override;
    { Checks, if the specified key exists.
      @param Key Key that is checked
      @return True, if the key exists; otherwise, false is returned. }
    function KeyExists(const Key: string): Boolean;
    { Clears all key-value pairs }
    procedure Clear;
    { Removes a key-value pair specified by its key
      @param Key Key string }
    procedure Remove(const Key: string);
    { Gets or sets values by their key. If a key does not exist then a
      ECPKeyNotFoundException is raised. }
    property Values[Key: string]: TObject read GetValues write SetValues;
    { Gets the number of elements in the hash map }
    property Count: Integer read FCount;
    { Moves to the successor of the specified hash item. If the specified
      hash item has no successor then false is returned; otherwise, true. }
    function GetNext(var Index: Integer; var Item: PCPHashItem): Boolean;
    { Returns values of all key-value-pairs in a list }
    function GetValueList: TObjectList;
  end;

implementation

{ TCPStringHashMap }

procedure TCPStringHashMap.Add(const Key: string; Value: TObject);
var
  Hash: Cardinal;
  Bucket: PCPHashItem;
  CanonicalKey: string;
begin
  CanonicalKey := GetCanonicalKey(Key);
  Hash := HashOf(CanonicalKey);
  Hash := Hash mod Cardinal(Length(FBuckets));
  New(Bucket);
  Bucket^.Key := CanonicalKey;
  Bucket^.Value := Value;
  Bucket^.Next := FBuckets[Hash];
  FBuckets[Hash] := Bucket;
  Inc(FCount);
end;

procedure TCPStringHashMap.Clear;
var
  I: Integer;
  P, N: PCPHashItem;
begin
  for I := 0 to Length(FBuckets) - 1 do
  begin
    P := FBuckets[I];
    while P <> nil do
    begin
      N := P^.Next;
      Dispose(P);
      P := N;
    end;
    FBuckets[I] := nil;
  end;
  FCount := 0;
end;

constructor TCPStringHashMap.Create(CaseSensitive: Boolean; Size: Cardinal);
begin
  FCaseSensitive := CaseSensitive;
  SetLength(FBuckets, Size);
  FCount := 0;
end;

destructor TCPStringHashMap.Destroy;
begin
  Clear;
  inherited Destroy;
end;

function TCPStringHashMap.Find(const Key: string): PPCPHashItem;
var
  Hash: Integer;
  CanonicalKey: string;
begin
  CanonicalKey := GetCanonicalKey(Key);
  Hash := HashOf(CanonicalKey) mod Cardinal(Length(FBuckets));
  Result := @FBuckets[Hash];
  while Result^ <> nil do
  begin
    if Result^.Key = CanonicalKey then
      Exit
    else
      Result := @Result^.Next;
  end;
end;

function TCPStringHashMap.GetCanonicalKey(Key: string): string;
begin
  if FCaseSensitive then
    Result := Key
  else
    Result := AnsiLowerCase(Key);
end;

function TCPStringHashMap.GetNext(var Index: Integer;
  var Item: PCPHashItem): Boolean;
begin
  if (Item = nil) or (Item.Next = nil) then
  begin
    // Search for next filled bucket:
    while Index < High(FBuckets) do
    begin
      Inc(Index);
      if FBuckets[Index] <> nil then
      begin
        Item := FBuckets[Index];
        Result := true;
        exit;
      end;
    end;
    Result := false;
  end
  else
  begin
    Item := Item.Next;
    Result := true;
  end;
end;

function TCPStringHashMap.GetValueList: TObjectList;
var
  Index: Integer;
  Item: PCPHashItem;
begin
  Result := TObjectList.Create(false);
  Result.Capacity := FCount;
  Index := -1;
  Item := nil;
  while GetNext(Index, Item) do
    Result.Add(Item.Value);
end;

function TCPStringHashMap.GetValues(Key: string): TObject;
var
 P: PCPHashItem;
begin
  P := Find(Key)^;
  if P <> nil then
    Result := P^.Value
  else
    raise ECPKeyNotFoundException.CreateFmt('Key "%s" does not exist.', [Key]);
end;

function TCPStringHashMap.HashOf(const CanonicalKey: string): Cardinal;
var
  I: Integer;
begin
  Result := 0;
  for I := 1 to Length(CanonicalKey) do
    Result := ((Result shl 2) or (Result shr (SizeOf(Result) * 8 - 2))) xor
      Ord(CanonicalKey[I]);
end;

function TCPStringHashMap.KeyExists(const Key: string): Boolean;
var
  P: PCPHashItem;
begin
  P := Find(Key)^;
  Result := P <> nil;
end;

function TCPStringHashMap.Modify(const Key: string; Value: TObject): Boolean;
var
  P: PCPHashItem;
begin
  P := Find(Key)^;
  if P <> nil then
  begin
    Result := True;
    P^.Value.Free; // Free old value
    P^.Value := Value;
  end
  else
    Result := False;
end;

procedure TCPStringHashMap.Remove(const Key: string);
var
  P: PCPHashItem;
  Prev: PPCPHashItem;
begin
  Prev := Find(Key);
  P := Prev^;
  if P <> nil then
  begin
    Prev^ := P^.Next;
    P.Value.Free; // Free value
    Dispose(P);
    Dec(FCount);
  end;
end;

procedure TCPStringHashMap.SetValues(Key: string; const Value: TObject);
begin
  if not Modify(key, Value) then
    Add(Key, Value);
end;

end.
